home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpc09905c.lha / fpc / inc / file.inc < prev    next >
Text File  |  1998-09-21  |  7KB  |  344 lines
  1. {
  2.     $Id: file.inc,v 1.6 1998/07/19 19:55:32 michael Exp $
  3.     This file is part of the Free Pascal Run time library.
  4.     Copyright (c) 1993,97 by the Free Pascal development team
  5.  
  6.     See the file COPYING.FPC, included in this distribution,
  7.     for details about the copyright.
  8.  
  9.     This program is distributed in the hope that it will be useful,
  10.     but WithOUT ANY WARRANTY; without even the implied warranty of
  11.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12.  
  13.  **********************************************************************}
  14.  
  15. {****************************************************************************
  16.                     subroutines For UnTyped File handling
  17. ****************************************************************************}
  18.  
  19. type
  20.   UnTypedFile=File;
  21.  
  22. Procedure Assign(var f:File;const Name:string);
  23. {
  24.   Assign Name to file f so it can be used with the file routines
  25. }
  26. Begin
  27.   FillChar(f,SizeOf(FileRec),0);
  28.   FileRec(f).Handle:=UnusedHandle;
  29.   FileRec(f).mode:=fmClosed;
  30.   Move(Name[1],FileRec(f).Name,Length(Name));
  31. End;
  32.  
  33.  
  34. Procedure assign(var f:File;p:pchar);
  35. {
  36.   Assign Name to file f so it can be used with the file routines
  37. }
  38. begin
  39.   Assign(f,StrPas(p));
  40. end;
  41.  
  42.  
  43. Procedure assign(var f:File;c:char);
  44. {
  45.   Assign Name to file f so it can be used with the file routines
  46. }
  47. begin
  48.   Assign(f,string(c));
  49. end;
  50.  
  51.  
  52. Procedure Rewrite(var f:File;l:Word);[IOCheck];
  53. {
  54.   Create file f with recordsize of l
  55. }
  56. Begin
  57.   If InOutRes <> 0 then exit;
  58.   If l=0 Then
  59.    InOutRes:=2
  60.   else
  61.    Begin
  62.      Do_Open(f,PChar(@FileRec(f).Name),$101);
  63.      FileRec(f).RecSize:=l;
  64.    End;
  65. End;
  66.  
  67.  
  68. Procedure Reset(var f:File;l:Word);[IOCheck];
  69. {
  70.   Open file f with recordsize of l and filemode
  71. }
  72. Begin
  73.   If InOutRes <> 0 then Exit;
  74.   If l=0 Then
  75.    InOutRes:=2
  76.   else
  77.    Begin
  78.      Do_Open(f,PChar(@FileRec(f).Name),Filemode);
  79.      FileRec(f).RecSize:=l;
  80.    End;
  81. End;
  82.  
  83.  
  84. Procedure Rewrite(Var f:File);[IOCheck];
  85. {
  86.   Create file with (default) 128 byte records
  87. }
  88. Begin
  89.   If InOutRes <> 0 then exit;
  90.   Rewrite(f,128);
  91. End;
  92.  
  93.  
  94. Procedure Reset(Var f:File);[IOCheck];
  95. {
  96.   Open file with (default) 128 byte records
  97. }
  98. Begin
  99.   If InOutRes <> 0 then exit;
  100.   Reset(f,128);
  101. End;
  102.  
  103.  
  104. Procedure BlockWrite(Var f:File;Var Buf;Count:Longint;var Result:Longint);[IOCheck];
  105. {
  106.   Write Count records from Buf to file f, return written records in result
  107. }
  108. Begin
  109.   If InOutRes <> 0 then exit;
  110.   Result:=Do_Write(FileRec(f).Handle,Longint(@Buf),Count*FileRec(f).RecSize) div FileRec(f).RecSize;
  111. End;
  112.  
  113.  
  114. Procedure BlockWrite(Var f:File;Var Buf;Count:Word;var Result:Word);[IOCheck];
  115. {
  116.   Write Count records from Buf to file f, return written records in Result
  117. }
  118. var
  119.   l : longint;
  120. Begin
  121.   If InOutRes <> 0 then exit;
  122.   BlockWrite(f,Buf,Count,l);
  123.   Result:=l;
  124. End;
  125.  
  126.  
  127. Procedure BlockWrite(Var f:File;Var Buf;Count:Word;var Result:Integer);[IOCheck];
  128. {
  129.   Write Count records from Buf to file f, return written records in Result
  130. }
  131. var
  132.   l : longint;
  133. Begin
  134.   If InOutRes <> 0 then exit;
  135.   BlockWrite(f,Buf,Count,l);
  136.   Result:=l;
  137. End;
  138.  
  139.  
  140. Procedure BlockWrite(Var f:File;Var Buf;Count:Longint);[IOCheck];
  141. {
  142.   Write Count records from Buf to file f, if none a Read and Count>0 then
  143.   InOutRes is set
  144. }
  145. var
  146.   Result : Longint;
  147. Begin
  148.   If InOutRes <> 0 then exit;
  149.   BlockWrite(f,Buf,Count,Result);
  150.   If (Result=0) and (Count>0) Then
  151.    InOutRes:=101;
  152. End;
  153.  
  154.  
  155. Procedure BlockRead(var f:File;var Buf;Count:Longint;var Result:Longint);[IOCheck];
  156. {
  157.   Read Count records from file f ro Buf, return nuùber of read records in
  158.   Result
  159. }
  160. Begin
  161.   Result:=0;
  162.   If InOutRes <> 0 then exit;
  163.   Result:=Do_Read(FileRec(f).Handle,Longint(@Buf),count*FileRec(f).RecSize) div FileRec(f).RecSize;
  164. End;
  165.  
  166.  
  167. Procedure BlockRead(var f:File;var Buf;count:Word;var Result:Word);[IOCheck];
  168. {
  169.   Read Count records from file f to Buf, return number of read records in
  170.   Result
  171. }
  172. var
  173.   l : longint;
  174. Begin
  175.   Result:=0;
  176.   If InOutRes <> 0 then exit;
  177.   BlockRead(f,Buf,Count,l);
  178.   Result:=l;
  179. End;
  180.  
  181.  
  182. Procedure BlockRead(var f:File;var Buf;count:Word;var Result:Integer);[IOCheck];
  183. {
  184.   Read Count records from file f to Buf, return number of read records in
  185.   Result
  186. }
  187. var
  188.   l : longint;
  189. Begin
  190.   Result:=0;
  191.   If InOutRes <> 0 then exit;
  192.   BlockRead(f,Buf,Count,l);
  193.   Result:=l;
  194. End;
  195.  
  196.  
  197. Procedure BlockRead(Var f:File;Var Buf;Count:Longint);[IOCheck];
  198. {
  199.   Read Count records from file f to Buf, if none are read and Count>0 then
  200.   InOutRes is set
  201. }
  202. var
  203.   Result : Longint;
  204. Begin
  205.   If InOutRes <> 0 then exit;
  206.   BlockRead(f,Buf,Count,Result);
  207.   If (Result=0) and (Count>0) Then
  208.    InOutRes:=100;
  209. End;
  210.  
  211.  
  212. Function FilePos(var f:File):Longint;[IOCheck];
  213. {
  214.   Return current Position In file f in records
  215. }
  216. Begin
  217.   If InOutRes <> 0 then exit;
  218.   FilePos:=Do_FilePos(FileRec(f).Handle) div FileRec(f).RecSize;
  219. End;
  220.  
  221.  
  222. Function FileSize(var f:File):Longint;[IOCheck];
  223. {
  224.   Return the size of file f in records
  225. }
  226. Begin
  227.   If InOutRes <> 0 then exit;
  228.   if FileRec(f).RecSize=0 then
  229.    FileSize:=0
  230.   else
  231.    FileSize:=Do_FileSize(FileRec(f).Handle) div FileRec(f).RecSize;
  232. End;
  233.  
  234.  
  235. Function Eof(var f:File):Boolean;[IOCheck];
  236. {
  237.   Return True if we're at the end of the file f, else False is returned
  238. }
  239. Begin
  240.   If InOutRes <> 0 then exit;
  241.   {Can't use do_ routines because we need record support}
  242.   Eof:=(FileSize(f)<=FilePos(f));
  243. End;
  244.  
  245.  
  246. Procedure Seek(var f:File;Pos:Longint);[IOCheck];
  247. {
  248.   Goto record Pos in file f
  249. }
  250. Begin
  251.   If InOutRes <> 0 then exit;
  252.   Do_Seek(FileRec(f).Handle,Pos*FileRec(f).RecSize);
  253. End;
  254.  
  255.  
  256. Procedure Truncate(Var f:File);[IOCheck];
  257. {
  258.   Truncate/Cut file f at the current record Position
  259. }
  260. Begin
  261.   If InOutRes <> 0 then exit;
  262.   Do_Truncate(FileRec(f).Handle,FilePos(f)*FileRec(f).RecSize);
  263. End;
  264.  
  265.  
  266. Procedure Close(var f:File);[IOCheck];
  267. {
  268.   Close file f
  269. }
  270. Begin
  271.   If InOutRes <> 0 then exit;
  272.   If (FileRec(f).mode<>fmClosed) Then
  273.    Begin
  274.      FileRec(f).mode:=fmClosed;
  275.      Do_Close(FileRec(f).Handle);
  276.    End;
  277. End;
  278.  
  279.  
  280. Procedure Erase(var f : File);[IOCheck];
  281. Begin
  282.   If InOutRes <> 0 then exit;
  283.   If FileRec(f).mode=fmClosed Then
  284.    Do_Erase(PChar(@FileRec(f).Name));
  285. End;
  286.  
  287.  
  288. Procedure Rename(var f : File;p:pchar);[IOCheck];
  289. Begin
  290.   If InOutRes <> 0 then exit;
  291.   If FileRec(f).mode=fmClosed Then
  292.    Begin
  293.      Do_Rename(PChar(@FileRec(f).Name),p);
  294.      Move(p^,FileRec(f).Name,StrLen(p)+1);
  295.    End;
  296. End;
  297.  
  298.  
  299. Procedure Rename(var f : File;const s : string);[IOCheck];
  300. var
  301.   p : array[0..255] Of Char;
  302. Begin
  303.   If InOutRes <> 0 then exit;
  304.   Move(s[1],p,Length(s));
  305.   p[Length(s)]:=#0;
  306.   Rename(f,Pchar(@p));
  307. End;
  308.  
  309.  
  310. Procedure Rename(var f : File;c : char);[IOCheck];
  311. var
  312.   p : array[0..1] Of Char;
  313. Begin
  314.   If InOutRes <> 0 then exit;
  315.   p[0]:=c;
  316.   p[1]:=#0;
  317.   Rename(f,Pchar(@p));
  318. End;
  319.  
  320. {
  321.   $Log: file.inc,v $
  322.   Revision 1.6  1998/07/19 19:55:32  michael
  323.   + fixed rename. Changed p to p^
  324.  
  325.   Revision 1.5  1998/07/02 12:15:39  carl
  326.     + Each IOCheck routine now checks for InOures before executing, like TP
  327.  
  328.   Revision 1.4  1998/06/23 16:57:16  peter
  329.     * fixed the filesize() problems under linux and filerec.size=0 error
  330.  
  331.   Revision 1.3  1998/05/21 19:30:56  peter
  332.     * objects compiles for linux
  333.     + assign(pchar), assign(char), rename(pchar), rename(char)
  334.     * fixed read_text_as_array
  335.     + read_text_as_pchar which was not yet in the rtl
  336.  
  337.   Revision 1.2  1998/05/12 10:42:44  peter
  338.     * moved getopts to inc/, all supported OS's need argc,argv exported
  339.     + strpas, strlen are now exported in the systemunit
  340.     * removed logs
  341.     * removed $ifdef ver_above
  342.  
  343. }
  344.